//////////
// 设变量 let/letstar/letrec ???

#include <string.h>
#include <limits.h>
#include "../basic/operator.h"
#include "../basic/basic.h"

//let的形式 (let let_name? ((var_name init_expr) ...) body_expr ...) let_name字段可有可无
Cell* op_let0(Scheme *sc) {
	log(sc, "syntax/let", "op_let0");
	sc->args = G_NIL;
	sc->returnValue = sc->code; //sc->returnValue形式 (let_name? ((var_name init_expr) ...) body_expr ...)
	//let分为命名的let 和未命名的let
	sc->code = is_variable(sc->code) ? second(sc->code) : first(sc->code); //sc->code形式 ((var_name init_expr) ...)
	sc->op = cell_op_let1;
	log(sc, "syntax/let", "op_let0");
	return G_TRUE;
}

Cell* op_let1(Scheme *sc) {
	log(sc, "syntax/let", "op_let1");
	sc->args = cons(sc, sc->returnValue, sc->args); //这里的结果为 (init_result ...  (let_name? ((var_name init_expr) ...) body_expr ...) )
	if (type_of(sc, sc->code, PAIR_TYPE)) { /* continue */
		if (!type_of(sc, car(sc->code), PAIR_TYPE) || !type_of(sc, cdar(sc->code), PAIR_TYPE)) {
            sc->returnValue = make_default_exception_1(sc, "BAD_SYNTAX", "Bad syntax of binding spec in let : %s", cell2str(sc, car(sc->code)));
            return pop_callstack(sc);
		}
		push_callstack(sc, cell_op_let1, sc->args, cdr(sc->code));
		sc->code = cadar(sc->code); //sc->code形式 init_expr
		sc->args = G_NIL;
		//对init_expr求值 ，假设其返回值为 init_result
		sc->op = cell_op_eval;
		log(sc, "syntax/let", "op_let1");
		return G_TRUE;
	} else { /* end */
		sc->args = reverse(sc, sc->args); //反序 结果为  ( (let_name? ((var_name init_expr) ...) body_expr ...) init_result ... )
		sc->code = car(sc->args); //结果为(let_name? ((var_name init_expr) ...) body_expr ...)
		sc->args = cdr(sc->args); //结果为(init_result ... )
		sc->op = cell_op_let2;
		log(sc, "syntax/let", "op_let1");
		return G_TRUE;
	}
}

Cell* op_let2(Scheme *sc) {
	Cell *x, *y;

	log(sc, "syntax/let", "op_let2");

	Cell* frame = make_vector(sc, DEFAULT_FRAME_SIZE);
	extend_environment(sc, frame, sc->env);

	//new_frame_in_env(sc, sc->env); //为let创建一个新的环境
	x = is_variable(car(sc->code)) ? cadr(sc->code) : car(sc->code); //如果第一个节点就是符号，这个符号是let_name，要跳过 ，最后x的结果为((var_name init_expr) ...)
	for (y = sc->args; y != G_NIL; x = cdr(x), y = cdr(y)) { //y为(init_result ...)
		//new_slot_in_env(sc, caar(x), car(y)); //caar(x)为var_name , y为 init_result
		add_binding_to_frame(sc, frame, caar(x)->_name, car(y), FALSE);
	}
	if (is_variable(car(sc->code))) { /* named let *///命名let
		//这里将命名let转化为一个闭包，这里没有尾递归优化
		for (x = cadr(sc->code), sc->args = G_NIL; x != G_NIL; x = cdr(x)) {//x为((var_name init_expr) ...)
			//这个循环的目的就是吧var_name都抽取出来
			if (!type_of(sc, x, PAIR_TYPE)) {
				sc->returnValue = make_default_exception_1(sc, "BAD_SYNTAX", "Bad syntax of binding in let : %s", cell2str(sc, x));
				return pop_callstack(sc);
			}

			if (!is_list(sc, car(x))) {
				sc->returnValue = make_default_exception_1(sc, "BAD_SYNTAX", "Bad syntax of binding in let : %s", cell2str(sc, car(x)));
				return pop_callstack(sc);
			}

			sc->args = cons(sc, caar(x), sc->args); //sc->args为(var_name ...) ,这里var_name的顺序和sc->code中对应的var_name的顺序是相反的
		}
		x = make_closure(sc, cons(sc, reverse(sc, sc->args), cddr(sc->code)), sc->env); //创建闭包
		//new_slot_in_env(sc, car(sc->code), x); //为新创建的闭包定义一个名字
		add_binding_to_frame(sc, frame, car(sc->code)->_name, x, FALSE);
		sc->code = cddr(sc->code);//跳过let_name和var_name初始化部分 ，最后 sc->code 是 ( body_expr ...)
		sc->args = G_NIL;
	} else {
		sc->code = cdr(sc->code);//跳过var_name初始化部分 ，最后 sc->code 是 ( body_expr ...)
		sc->args = G_NIL;
	}
	//对( body_expr ...)部分进行求值
	sc->op = cell_op_begin;
	log(sc, "syntax/let", "op_let2");
	return G_TRUE;
}

Cell* op_letstar0(Scheme *sc) {
	log(sc, "syntax/let", "op_letstar0");
	//let*的形式是这样的 (let* ((var_name init_expr) ...) body_expr ...)
	if (car(sc->code) == G_NIL) {
		//new_frame_in_env(sc, sc->env);
		Cell* frame = make_vector(sc, DEFAULT_FRAME_SIZE);
		extend_environment(sc, frame, sc->env);

		sc->code = cdr(sc->code);
		sc->op = cell_op_begin;
		log(sc, "syntax/let", "op_letstar0");
		return G_TRUE;
	}
	if (!IS_PARE(sc, car(sc->code)) || !IS_PARE(sc, caar(sc->code)) || !IS_PARE(sc, cdaar(sc->code))) {
		sc->returnValue = make_default_exception_1(sc, "BAD_SYNTAX", "Bad syntax of binding spec in let* : %s", cell2str(sc, car(sc->code)));
		return pop_callstack(sc);
	}
	push_callstack(sc, cell_op_letstar1, cdr(sc->code), car(sc->code));// cdr(sc->code)为 (body_expr ...)  。 car(sc->code)为 ((var_name init_expr) ...)
	sc->code = cadaar(sc->code);//sc->code最后为init_expr 这个代码要使用let*外层的环境（特别的一个情形是，如果这是个lambda表达式，就会绑定到外层的环境上）
	sc->op = cell_op_eval;
	log(sc, "syntax/let", "op_letstar0");
	return G_TRUE; //对第一个var_name的初始化表达式求值 ，求值的结果假设为init_result
}

Cell* op_letstar1(Scheme *sc) {
	log(sc, "syntax/let", "op_letstar1");
	//new_frame_in_env(sc, sc->env); //为let*创建一个环境
	Cell* frame = make_vector(sc, DEFAULT_FRAME_SIZE);
	extend_environment(sc, frame, sc->env);
	sc->op = cell_op_letstar2;
	log(sc, "syntax/let", "op_letstar1");
	return G_TRUE;
}

Cell* op_letstar2(Scheme *sc) {
	// sc->args为 (body_expr ...)  。 sc->code为 ((var_name init_expr) ...)
	//new_slot_in_env(sc, caar(sc->code), sc->returnValue);// caar(sc->code)为var_name  sc->returnValue为init_result

	//set_variable_value(sc, sc->env, caar(sc->code), sc->returnValue);

	log(sc, "syntax/let", "op_letstar2");
	add_binding_to_frame(sc, first(sc->env), caar(sc->code)->_name, sc->returnValue, FALSE);

	sc->code = cdr(sc->code);
	if (type_of(sc, sc->code, PAIR_TYPE)) { /* continue */
		push_callstack(sc, cell_op_letstar2, sc->args, sc->code);
		sc->code = cadar(sc->code); //sc->code最后为init_expr
		sc->args = G_NIL;
		//对init_expr求值
		sc->op = cell_op_eval;
		log(sc, "syntax/let", "op_letstar2");
		return G_TRUE;
	} else { /* end */
		sc->code = sc->args; //sc->code最后为(body_expr ...)
		sc->args = G_NIL;
		//对(body_expr ...)求值
		sc->op = cell_op_begin;
		log(sc, "syntax/let", "op_letstar2");
		return G_TRUE;
	}
}

Cell* op_let0rec(Scheme *sc) {
	log(sc, "syntax/let", "op_let0rec");
	//形式 (letrec ((var_name init_expr) ... ) body)
	//new_frame_in_env(sc, sc->env);
	Cell* frame = make_vector(sc, DEFAULT_FRAME_SIZE);
	extend_environment(sc, frame, sc->env);

	sc->args = G_NIL;
	sc->returnValue = sc->code;
	sc->code = car(sc->code);
	sc->op = cell_op_let1rec;
	log(sc, "syntax/let", "op_let0rec");
	return G_TRUE;
}

Cell* op_let1rec(Scheme *sc) {
	log(sc, "syntax/let", "op_let1rec");
	sc->args = cons(sc, sc->returnValue, sc->args);
	if (type_of(sc, sc->code, PAIR_TYPE)) { /* continue */
		if (!type_of(sc, car(sc->code), PAIR_TYPE) || !type_of(sc, cdar(sc->code), PAIR_TYPE)) {
			//return error_helper(sc, "Bad syntax of binding spec in letrec :", car(sc->code));
            sc->returnValue = make_default_exception_1(sc, "BAD_SYNTAX", "Bad syntax of binding spec in letrec : %s", cell2str(sc, car(sc->code)));
            return pop_callstack(sc);
		}
		push_callstack(sc, cell_op_let1rec, sc->args, cdr(sc->code));
		sc->code = cadar(sc->code);
		sc->args = G_NIL;
		sc->op = cell_op_eval;
		log(sc, "syntax/let", "op_let1rec");
		return G_TRUE;
	} else { /* end */
		sc->args = reverse(sc, sc->args);
		sc->code = car(sc->args);
		sc->args = cdr(sc->args);
		sc->op = cell_op_let2rec;
		log(sc, "syntax/let", "op_let1rec");
		return G_TRUE;
	}
}

Cell* op_let2rec(Scheme *sc) {
	Cell *x, *y;

	log(sc, "syntax/let", "op_let2rec");

	for (x = car(sc->code), y = sc->args; y != G_NIL; x = cdr(x), y = cdr(y)) {
		//new_slot_in_env(sc, caar(x), car(y));
		//set_variable_value(sc, sc->env, caar(x), car(y));
		add_binding_to_frame(sc, first(sc->env), caar(x)->_name, car(y), FALSE);
	}
	sc->code = cdr(sc->code);
	sc->args = G_NIL;
	sc->op = cell_op_begin;
	log(sc, "syntax/let", "op_let2rec");
	return G_TRUE;
}

void init_let_operators(Scheme *sc) {
	ADD_OPERATOR(sc, "$let0", let0);
	ADD_OPERATOR(sc, "$let1", let1);
	ADD_OPERATOR(sc, "$let2", let2);
	ADD_OPERATOR(sc, "$letstar0", letstar0);
	ADD_OPERATOR(sc, "$letstar1", letstar1);
	ADD_OPERATOR(sc, "$letstar2", letstar2);
	ADD_OPERATOR(sc, "$let0rec", let0rec);
	ADD_OPERATOR(sc, "$let1rec", let1rec);
	ADD_OPERATOR(sc, "$let2rec", let2rec);

	ADD_SYNTAX(sc, "let", let0);
	ADD_SYNTAX(sc, "let*", letstar0);
	ADD_SYNTAX(sc, "letrec", let0rec);
}
